perm filename LOAD20.FAI[D,SYS] blob sn#259005 filedate 1977-01-24 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00006 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	TITLE LOAD20
C00004 00003	LOC 100140		PTR 0 GOES TO 140 IN CORE
C00006 00004	READ FILE SPECS FROM TTY INTO BLOCK
C00011 00005	GET WORD FROM DKIC FILE INTO I
C00012 00006	SAVPPN:	0		HAS CURRENT DSK PPN
C00013 ENDMK
C⊗;
TITLE LOAD20

F←0
A←1
B←2
C←3
D←4
E←5
G←6
T←7
TT←10
I←11
J←12
K←13
L←14
M←15
N←16
P←17

DKIC←←1
DKOC←←2
PTRC←←3

DEFINE CRLF
<	OUTCHR [15]
	OUTCHR [12]
>

DEFINE GETFIL $ (LE,STR,LH,CH,BUF,BYTE)
<ZZ←←.
IFDIF <STR><><OUTSTR [ASCIZ /$STR$/]>
	PUSHJ P,FILSCN	;INPUT FILE SPECS
IFIDN <LE> <L> <LH,,LUP>
IFIDN <LE> <E> <LH,,ENT>
	JRST [	CRLF		;ALT TYPED
		JRST MAIN]
	JRST [	OUTSTR [ASCIZ /??
/]					;GARBAGE TYPED
		CLRBFI
		JRST ZZ]
	INIT CH,10
	'DSK   '
IFIDN <LE> <E> <BUF,,> IFIDN <LE> <L> <BUF>
	JRST INITL
IFIDN <LE> <L> <LOOKUP CH,LUP
	JRST [	PUSHJ P,LUPFL
		JRST ZZ]>
IFIDN <LE> <E> <ENTER CH,ENT
	JRST [	PUSHJ P,ENTFL
		JRST ZZ]>
	MOVEI A,BYTE
	DPB A,[300600,,BUF+1]
>
LOC 100140		;PTR 0 GOES TO 140 IN CORE

PTR←←104

GO:	RESET
	MOVE P,[-20,,PDL-1]
	SETZM 140
	MOVE A,[140,,141]
	BLT A,GO-1
	OUTSTR [ASCIZ /PLACE TAPE IN THE READER AND TYPE ANY CHARACTER
/]
	CLRBFI
	INCHRW A
	CLRBFI
	INIT PTRC,13
	SIXBIT /PTR/
	PIBUF
	JRST 4,.
	MOVEI C,0
LOOP:	PUSHJ P,PGET
	HLRZ A,I
	CAIE A,(<DATAI PTR,>)
	JRST LOOP1
	HRRZ A,I		;ADDRESS FOR NEXT WORD
	CAIGE C,(A)
	MOVEI C,(A)		;C ← HIGHEST ADDRESS LOADED
	PUSHJ P,PGET
	MOVEM I,140(A)
	JRST LOOP

LOOP2:	OUTSTR [ASCIZ /
TAPE WORD NOT DATAI PTR, OR JRST 4,
/]
	EXIT

LOOP1:	CAIE A,(<JRST 4,>)
	JRST LOOP2
	PUSH P,C
	OUTSTR [ASCIZ /STARTING ADDRESS = /]
	HRRZ D,I
	PUSHJ P,OCTTYP
MAIN:	GETFIL (E,TYPE DMP FILE NAME - ,'DMP',DKOC,OBUF,=36)
	POP P,C
	MOVN C,C
	HRLZ C,C
	ADD C,[74,,74]
LOOP3:	MOVE I,140(C)
	PUSHJ P,PUT
	AOBJN C,LOOP3
	OUTSTR [ASCIZ /
DONE
/]
	EXIT


PGET:	SOSG PIBUF+2
	IN PTRC,
	JRST PGET1
	STATO PTRC,20000
	JRST [	OUTSTR [ASCIZ /TAPE ERROR
/]
		JRST 4,.]
	OUTSTR [ASCIZ /TAPE END OF FILE
/]
	EXIT

PGET1:	ILDB I,PIBUF+1
	POPJ P,
;READ FILE SPECS FROM TTY INTO BLOCK
;WORD AFTER CALL IS DEFAULT EXTENSION,,BLK ADDRESS.
;DOESNT SKIP IF ALT MODE TYPED.
;SKIPS ONCE IF SYNTAX ERROR, TWICE IF OK.
FILSCN:	MOVE L,@(P)
	HLLZM L,1(L)	;SET UP DEFAULT EXTENSION
	AOS (P)
	MOVE I,SAVPPN
	MOVEM I,3(L)	;INITIALIZE TO CURRENT DSK PPN
	PUSHJ P,GETSIX	;SYMBOL IN J, SEPARATOR IN I
	CAIN I,175	;ALT MODE
	POPJ P,
	AOS (P)
	MOVEM J,(L)
	CAIN I,"."
	JRST FILSCX	;GET EXTENSION
	CAIN I,"["
	JRST FILSCP	;GET PPN
	CAIN I,12
POPJ1:	AOS (P)
CPOPJ:	POPJ P,

FILSCX:	PUSHJ P,GETSIX
	HLLZM J,1(L)
	CAIN I,12
	JRST POPJ1
	CAIE I,"["
	POPJ P,
FILSCP:	PUSHJ P,GETSIX
	JUMPE J,FILSP3
FILSP1:	TLNE J,77	;RIGHT ADJUST
	JRST FILSP2
	LSH J,-6
	JRST FILSP1

FILSP2:	HLLM J,3(L)	;STORE PROJ NUMBER
FILSP3:	CAIN I,","
	JRST FILSP4	;GET PROGRAMMER NAME
FILSP8:	CAIN I,"]"
	JRST FILSP5	;DONE
	CAIN I,12
	AOS (P)
	POPJ P,

FILSP4:	PUSHJ P,GETSIX
	JUMPE J,FILSP8
FILSP6:	TLNE J,77
	JRST FILSP7
	LSH J,-6
	JRST FILSP6

FILSP7:	HLRM J,3(L)
	JRST FILSP8

FILSP5:	PUSHJ P,GETSIX
	CAIN I,12
	JRST POPJ1
	JRST FILSP5

LUPFL:	OUTSTR [ASCIZ /LOOKUP FAILED - /]
	MOVEI L,LUP
FILNOU:	MOVE I,(L)
	PUSHJ P,SIXTYP
	OUTCHR ["."]
	MOVE I,1(L)
	PUSHJ P,SIXTY3
	OUTCHR ["["]
	MOVE I,3(L)
	PUSHJ P,SIXTY3
	OUTCHR [","]
	MOVS I,3(L)
	PUSHJ P,SIXTY3
	OUTSTR [ASCIZ /]
/]
	POPJ P,

ENTFL:	OUTSTR [ASCIZ /ENTER FAILED - /]
	MOVEI L,ENT
	JRST FILNOU

;GET SIXBIT SYLLABLE IN J WITH SEPARATOR IN I
GETSIX:	MOVE K,[440600,,J]
	SETZB F,J
GETSX1:	INCHWL I
	CAIN I,15
	JRST GETSX1
	CAIL I,"0"
	CAILE I,"9"
	JRST GETSX2	;NOT NUM
	JRST GETSX3	;NUMBER
GETSX2:	CAIL I,"a"
	CAILE I,"z"
	JRST GETSX4	;NOT LOWER CASE
	JRST GETSX5	;LOWER CASE
GETSX4:	CAIL I,"A"
	CAILE I,"Z"
	JRST GETSX6
GETSX3:	SUBI I,40
GETSX5:	TLNE K,770000
	IDPB I,K
	JRST GETSX1

GETSX6:	CAIN I,"↓"
	JRST GETSX7
	TRNN F,1
	POPJ P,
	JRST GETSX5

GETSX7:	XORI F,1
	JRST GETSX1

;TYPE I IN SIXBIT (6 CHARS WORTH)
SIXTYP:	MOVE J,[440600,,I]
SIXTY1:	ILDB K,J
	ADDI K,40
	OUTCHR K
	TLNE J,770000
	JRST SIXTY1
	POPJ P,

;TYPE LEFT 3 CHARS OF I
SIXTY3:	MOVE J,[440600,,I]
SIXTY4:	ILDB K,J
	ADDI K,40
	OUTCHR K
	TLNE J,500000
	JRST SIXTY4
	POPJ P,

INITL:	OUTSTR [ASCIZ /CAN'T INIT DSK - LOSEY, LOSEY
/]
	JRST 4,.

GETNUM:	SETZM MINUSF
	MOVEI A,0
GETNM1:	INCHWL B
	CAIN B,"-"
	JRST [SETOM MINUSF ↔ JRST GETNM1]
	CAIN B,15
	JRST GETNM1
	CAIN B,12
	JRST GETNMX
	CAIN B,175
	JRST POPJ1
	CAIL B,"0"
	CAILE B,"7"
	POPJ P,
	LSH A,3
	ADDI A,-"0"(B)
	AOJA C,GETNM1

GETNMX:	SKIPGE MINUSF
	MOVNS A
POPJ2:	AOS (P)
	JRST POPJ1

OCTTYP:	PUSH P,G
	MOVEI G,10
	JRST DECTY

DECTYP:	PUSH P,G
	MOVEI G,=10
DECTY:	PUSH P,D
	PUSH P,E
	PUSHJ P,DECTY1
	POP P,E
	POP P,D
	POP P,G
	POPJ P,

DECTY1:	IDIVI D,(G)
	HRLM E,(P)
	SKIPE D
	PUSHJ P,DECTY1
	HLRZ E,(P)
	ADDI E,"0"
	OUTCHR E
	POPJ P,
;GET WORD FROM DKIC FILE INTO I
;SKIP RETURNS UNLESS EOF

ZZ←←0
DEFINE GETGEN $ (DKIC,GETIN,IBUF)
<
GETIN$R:	SOSG IBUF+2
	IN DKIC,
	JRST GETIN$1
	STATZ DKIC,20000	;EOF?
	POPJ P,			;YES
	JRST 4,.		;NO
GETIN$1:	ILDB I,IBUF+1
	JRST POPJ1

GETIN:	PUSHJ P,GETIN$R
	JRST GETEOF
	POPJ P,

GETIN$B:	PUSHJ P,GETIN
IFG ZZ,<JRST GTINB1>
IFE ZZ,<ZZ←←ZZ+1
GTINB1:	LSH I,=24
	ASH I,-=24
	POPJ P,>
>

GETGEN (DKIC,GETIN,IBUF)

GETEOF:	OUTSTR [ASCIZ /
EOF ON INPUT
/]
	CLOSE DKOC,
	EXIT

PUT:	SOSG OBUF+2
	OUT DKOC,
	JRST PUT1
	JRST 4,.
PUT1:	IDPB I,OBUF+1
	POPJ P,
SAVPPN:	0		;HAS CURRENT DSK PPN
LUP:	BLOCK 4
ENT:	BLOCK 4
IBUF:	BLOCK 3
OBUF:	BLOCK 3
MINUSF:	0
PDL:	BLOCK 20
PIBUF:	BLOCK 3

	END GO